home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / comm / tlx_hype.zip / HYPE.PAS < prev    next >
Pascal/Delphi Source File  |  1987-05-27  |  44KB  |  1,439 lines
  1. {.PW132}
  2. {.HE HYPE.PAS                                        Page # }
  3. {$R+,V-}
  4. PROGRAM HyperText ;
  5.  
  6. (* Copyright 1987 - Knowledge Garden Inc.
  7.                     473A Malden Bridge Rd.
  8.                     R.D. 2
  9.                     Nassau, NY 12123       *)
  10.  
  11.  
  12. (* This program implements the hypertext technique described in the
  13.    AI apprentice column in August 1987 issue of AI Expert Magazine.
  14.  
  15.    This program has been tested using Turbo ver 3.01A on an IBM PC/AT and
  16.    two PC clones. It has  been run under both DOS 3.2 and Concurrent 5.0 .
  17.  
  18.    We would be pleased to hear your comments, good or bad, or any applications
  19.    and modifications of the program. Contact us at:
  20.  
  21.      AI Expert
  22.      Miller Freeman Publications
  23.      500 Howard Street
  24.      San Francisco, CA 94105
  25.  
  26.    or on the AI Expert BBS. Our id is BillandBev Thompson ,[76703,4324].
  27.    You can also contact us on BIX, our id is bbt.
  28.  
  29.    Bill and Bev Thompson    *)
  30.  
  31.  
  32.  CONST
  33.   color_base = $B800 ;   (* Location of PC color screen memory map *)
  34.   mono_base = $B000 ;    (* Location of PC mono screen memory map *)
  35.   esc = #27 ;      (* These rest of these constants could have been defined in *)
  36.   F10 = #68 ;      (* process_file, but we put them here for convenience *)
  37.   left_arrow = #75 ;
  38.   right_arrow = #77 ;
  39.   PgUp = #73 ;
  40.   PgDn = #81 ;
  41.   mark_char = '\' ;
  42.   enter = #13 ;
  43.   def_window_size_x = 65 ;
  44.   def_window_size_y = 12 ;
  45.   def_fore_color = white ;
  46.   def_back_color = red ;
  47.  
  48.  
  49.  TYPE
  50.   counter = 0 .. maxint ;
  51.   text_file = text[2048] ;
  52.   string255 = string[255] ;
  53.   string80 = string[80] ;
  54.   char_ptr = ^char ;
  55.   col_pos = 1 .. 80 ;      (* The PC screen is 80 by 25 *)
  56.   row_pos = 1 .. 25 ;
  57.   color = 0 .. 31 ;
  58.   window_pos = RECORD           (* cursor location on screen *)
  59.                 x : col_pos ;
  60.                 y : row_pos ;
  61.                END ;
  62.   window_ptr = ^window_desc ;
  63.   window_desc = RECORD                        (* Basic window description *)
  64.                  next_window : window_ptr ;   (* windows are linked lists of *)
  65.                  prev_window : window_ptr ;   (* these descriptors *)
  66.                  abs_org     : window_pos ;   (* origin relative to upper left *)
  67.                  window_size : window_pos ;   (* rows and columns in window *)
  68.                  cursor_pos  : window_pos ;   (* saves current cursor location *)
  69.                  has_frame   : boolean ;      (* size and org do not include frame *)
  70.                  fore_color  : color ;
  71.                  back_color  : color ;
  72.                  scrn_area   : char_ptr ;      (* pointer to actual window data *)
  73.                 END ;
  74.   string_ptr = ^string255 ;   (* we don't actually allocate space for 255 chars *)
  75.   line_ptr = ^line_desc ;
  76.   line_desc = RECORD                 (* text is stored as a linked list *)
  77.                next_line : line_ptr ;
  78.                prev_line : line_ptr ;
  79.                txt       : string_ptr ; (* points to actual text data *)
  80.               END ;
  81.   mark_ptr = ^mark_desc ;
  82.   mark_desc = RECORD                   (* marked text is also a linked list *)
  83.                next_mark : mark_ptr ;
  84.                prev_mark : mark_ptr ;
  85.                mark_pos  : window_pos ;  (* location of start of mark in window *)
  86.                mark_text : string_ptr ;  (* actual marked text *)
  87.               END ;
  88.   dos_rec = RECORD                       (* used for low-level functions *)
  89.              CASE boolean OF
  90.               true  : (ax,bx,cx,dx,bp,si,di,ds,es,flags : integer) ;
  91.               false : (al,ah,bl,bh,cl,ch,dl,dh          : byte) ;
  92.              END ;
  93.   monitor_type = (color_monitor,mono_monitor,ega_monitor) ;
  94.  
  95.  
  96.  VAR
  97.   window_list,main_window,message_window,last_window : window_ptr ;
  98.   screen_base : char_ptr ;
  99.   monitor_kind : monitor_type ;
  100.   main_file : text_file ;
  101.   button_fore,button_back : color ;
  102.  
  103. (* Important variables:
  104.    window_list - points to a linked list of window descriptors,
  105.                  the top window is the currently active window.
  106.                  To write in a window, bring it to the front of the list.
  107.    last_window - points to end of window list
  108.    main_window - the big window, that text initially appears in
  109.    message_window - 2 line area at the bottom of the screen, available keys,
  110.                     commands etc. appear here
  111.    screen_base - points to actual memory location of screen, either
  112.                  mono_base or color_base
  113.    main_file - the original text file, the one we start the program with
  114.    button_fore,
  115.    button_back - the button is the large cursor which moves from mark to mark
  116.                  on a color screen it is yellow on black, on a mono screen
  117.                  the text is underlined. *)
  118.  
  119.  
  120.  (* Note - In most cases this program uses the Turbo standard string
  121.            functions. You can probably get better performance by turning
  122.            off range checking and accessing the strings directly, but
  123.            we didn't want to make this program even less portable than it
  124.            already is. *)
  125.  
  126. (* \\\\\\\\\\\\\ Basic Utility Routines  \\\\\\\\\\\\\\\\\\\\\\ *)
  127.  
  128.  FUNCTION min(x,y : integer) : integer ;
  129.   BEGIN
  130.    IF x <= y
  131.     THEN min := x
  132.     ELSE min := y ;
  133.   END ; (* min *)
  134.  
  135.  
  136.  FUNCTION max(x,y : integer) : integer ;
  137.   BEGIN
  138.    IF x >= y
  139.     THEN max := x
  140.     ELSE max := y ;
  141.   END ; (* max *)
  142.  
  143.  
  144.  PROCEDURE makestr(VAR s : string255 ; len : byte) ;
  145.   (* Fixes string "s" to length "len" - pads with blanks if necessary. *)
  146.   VAR
  147.    old_length : byte ;
  148.   BEGIN
  149.    old_length := length(s) ;
  150.    (*$R- *)
  151.    s[0] := chr(len) ;
  152.    (*$R+ *)
  153.    IF old_length < len
  154.     THEN fillchar(s[old_length+1],len - old_length,' ') ;
  155.   END ; (* makestr *)
  156.  
  157.  
  158.  FUNCTION toupper(s : string255) : string255 ;
  159.   (* converts a string to uppercase *)
  160.   VAR
  161.    i : byte ;
  162.   BEGIN
  163.    IF length(s) > 0
  164.     THEN
  165.      FOR i := 1 TO length(s) DO
  166.       s[i] := upcase(s[i]) ;
  167.    toupper := s ;
  168.   END ; (* toupper *)
  169.  
  170.  
  171.  PROCEDURE strip_leading_blanks(VAR s : string255) ;
  172.   (* Trim the leading blanks from a string *)
  173.   BEGIN
  174.    IF length(s) > 0
  175.     THEN
  176.      IF s[1] = ' '
  177.       THEN
  178.        BEGIN
  179.         delete(s,1,1) ;
  180.         strip_leading_blanks(s) ;
  181.        END ;
  182.   END ; (* strip_leading_blanks *)
  183.  
  184.  
  185.  PROCEDURE strip_trailing_blanks(VAR s : string255) ;
  186.   (* Trim the trailing blanks from a string *)
  187.   BEGIN
  188.    IF length(s) > 0
  189.     THEN
  190.      IF s[length(s)] = ' '
  191.       THEN
  192.        BEGIN
  193.         delete(s,length(s),1) ;
  194.         strip_trailing_blanks(s) ;
  195.        END ;
  196.   END ; (* strip_trailing_blanks *)
  197.  
  198.  
  199.  FUNCTION tointeger(s : string255) : integer ;
  200.   (* converts a string to an integer. Returns 0 for non-numeric strings *)
  201.   VAR
  202.    num : real ;
  203.    code : integer ;
  204.   BEGIN
  205.    strip_trailing_blanks(s) ;
  206.    strip_leading_blanks(s) ;
  207.    val(s,num,code) ;
  208.    IF code = 0
  209.     THEN
  210.      IF (num < -32768.0) OR (num > 32767.0)
  211.       THEN tointeger := 0
  212.       ELSE tointeger := trunc(num)
  213.     ELSE tointeger := 0 ;
  214.   END ; (* tointeger *)
  215.  
  216.  
  217.  FUNCTION open(VAR f : text_file ; f_name : string80) : boolean ;
  218.   (* Open a text file and return true if file can be opened *)
  219.   BEGIN
  220.    assign(f,f_name) ;
  221.    (*$I- *)
  222.    reset(f) ;
  223.    (*$I+ *)
  224.    open := (ioresult = 0) ;
  225.   END ; (* open *)
  226.  
  227.  
  228. (* \\\\\\\\\\\\\\\\\\\ Window Routines \\\\\\\\\\\\\\\\\\\\ *)
  229.  
  230.  PROCEDURE draw_frame(x1,y1,x2,y2 : counter ; title : string80 ;
  231.                       frame_color : color) ;
  232.   (* Draw a frame on the screen at absolute screen positions *)
  233.   (* x1,y1 - upper left corner *)
  234.   (* x2,y2 - lower right corner *)
  235.   CONST
  236.    bar = #196 ;
  237.    vert_bar = #179 ;
  238.    upper_lf = #218 ;
  239.    upper_rt = #191 ;
  240.    lower_lf = #192 ;
  241.    lower_rt = #217 ;
  242.   VAR
  243.    i : 1 .. 25 ;
  244.    border : string80 ;
  245.  
  246.   PROCEDURE get_frame_co_ords ;
  247.    BEGIN
  248.     x1 := min(max(1,x1),78) ;
  249.     y1 := min(max(1,y1),23) ;
  250.     x2 := min(max(3,x2),80) ;
  251.     y2 := min(max(3,y2),25) ;
  252.    END ; (* get_frame_co_ords *)
  253.  
  254.   PROCEDURE write_title ;
  255.    BEGIN
  256.     IF length(title) > (x2 - x1 - 1)
  257.      THEN title :=